home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Float source / fpExtra < prev    next >
Encoding:
Text File  |  1993-05-08  |  1.6 KB  |  61 lines  |  [TEXT/YERK]
  1. \ optional definitions for floating point
  2. \  1/24/86  gdc Moved f0=, f0<, and f0> from fpcode
  3. \ 12/25/92    rfl added fmax,fmin
  4. \  5/08/93    rfl    added arcsin, arccos
  5.  
  6. \ Some useful constants =============================================== \
  7.  
  8. 1.0                 fcon  1.0
  9. 0.0                 fcon  0.0     
  10. 1.0 arctan 4.0 f*   fcon  pi      
  11. 1.0 exp             fcon  e       
  12. 10.0 ln             fcon  ln(10)  
  13.  
  14. \ ===================================================================== \
  15.  
  16. ( -- bool )
  17. \ ( x -F- )         Zero-equal-to logical operator for floats
  18. : f0=       0.0 f= ;
  19.  
  20. ( -- bool )
  21. \ ( x -F- )         Zero-Less-than logical operator for floats
  22. : f0<       0.0 f< ;
  23.  
  24. ( -- bool )
  25. \ ( x -F- )         Zero-greater-than logical operator for floats
  26. : f0>       0.0 f> ;
  27.  
  28. \ ===================================================================== \
  29.  
  30. : 1/x   1.0 swap f/  ;
  31.  
  32. \ ( x -- log(x) )     log base 10 of x
  33. : log       ln ln(10) f/    ;
  34.  
  35. \ ( x -- antilog(x) ) antilog ( 10^x ) of x
  36. : antilog   ln(10) f* exp   ;
  37.  
  38. \ ( x -- cot(x) ) cotangent of x
  39. : cot       tan 1/x     ;
  40.   
  41. \ ( deg -F- rad ) converts degrees to radians
  42. : deg2Rad   PI f* 180. f/ ;
  43.  
  44. \ ( rad -F- deg ) converts radians to degrees
  45. : rad2Deg   180. f* PI f/ ;
  46.  
  47. : fmax ( f1 f2 -- fmax) f2dup f> IF fdrop ELSE swap fdrop THEN ;
  48. : fmin ( f1 f2 -- fmin) f2dup f< IF fdrop ELSE swap fdrop THEN ;
  49.  
  50. : arcsin { %x -- f }
  51.         %x fabs .3 f>= 
  52.         IF %x %x 1. f+ 1. %x f- f* sqrt f/ arctan
  53.         ELSE %x fabs f0>
  54.             IF %x 1. %x %x f* f- sqrt f/ arctan
  55.             ELSE 0.
  56.             THEN
  57.         THEN ;
  58.  
  59. : arccos { %x -- f }
  60.         1. %x f- 1. %x f+ f/ sqrt arctan 2. f* ;
  61.